home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Utilities / Miscellaneous / CopyPaste 3.3.4 / CopyPaste Tools Sourcecode / Word Caps / Word Caps.p < prev    next >
Encoding:
Text File  |  1997-06-06  |  2.2 KB  |  107 lines  |  [TEXT/CWIE]
  1. {•This sourcecode is an example for creating a FKey coderesource with•}
  2. {•Metrowerks Pascal. It is copyrighted by Peter Hoerster and released•}
  3. {•for free use in any Shareware or Freeware product as a way to thank all•}
  4. {•programmers who share code snippets. You may put this sources on any•}
  5. {•CD ROM or any Archive Server but you may not sell it. •}
  6.  
  7. {• For comments please write to <hoerster@muenster.de>•}
  8.  
  9.  
  10.  
  11. unit WordCaps;
  12.  
  13. interface
  14.  
  15.     uses
  16.         Types, OSUtils, GestaltEqu, Script, notification, Resources, Events,
  17.           QuickDraw, ToolUtils, Memory, LowMem, Scrap,pascalA4;
  18.  
  19.  
  20.  
  21. {$MAIN}
  22.                         
  23.     procedure main;        
  24.  
  25. implementation
  26.  
  27.     procedure dopaste;
  28.     const
  29.         pastecode=2422;
  30.     var 
  31.         qel: EvQelPtr;
  32.     begin
  33.     
  34.             if ppostevent(3, pastecode, qel) = noerr then
  35.             qel^.evtqmodifiers := cmdkey;
  36.     end;
  37.  
  38.  
  39.     procedure main;
  40.         
  41.         var
  42.             oldA4: LongInt;
  43.             myerr: oserr;
  44.             myclipsize, templongint: longint;
  45.             myclipHandle: handle;
  46.             
  47.         
  48.         procedure doLowercase;
  49.             const
  50.                 step = 1000;
  51.             var
  52.         
  53.             count, pos,rest,i,amount: longint;
  54.         begin
  55.             pos:=0;
  56.             count:=myclipsize div step;
  57.             rest:=myclipsize mod step;
  58.             
  59.             for i := 1 to count do
  60.                 begin
  61.                     amount := step;
  62.                     lowertext(Ptr(ord4(myclipHandle^)+pos), amount);
  63.                     pos := i * step;
  64.                 end;    
  65.             lowertext(Ptr(ord4(mycliphandle^)+pos), rest);
  66.         end;
  67.         procedure doCapitals;
  68.             var
  69.                 offset: integer;
  70.                 offsets: OffsetTable;
  71.  
  72.         begin
  73.             doLowercase;
  74.             offset := 0;
  75.             repeat
  76.                 FindWord(myclipHandle^, myclipsize, offset, true, nil, offsets);
  77.                 offset := offsets[0].offfirst;
  78.                 uppertext(ptr(ord4(myclipHandle^) + offset), 1);
  79.                 offset := offsets[0].offsecond;
  80.             until offset >= myclipsize;
  81.         end;
  82.         
  83.     begin
  84.         oldA4 := SetCurrentA4;
  85.         myclipsize := GetScrap(nil, 'TEXT', templongint);
  86.         mycliphandle := Tempnewhandle(myclipsize,myerr);
  87.         if myerr=noerr then 
  88.             begin
  89.                 myclipsize := GetScraP(myclipHandle, 'TEXT', templongint);
  90.                 if myclipsize > 0 then
  91.                     begin
  92.                         Temphlock(mycliphandle,myerr);
  93.                         if myerr=noerr then 
  94.                             begin
  95.                                 
  96.                                 doCapitals;
  97.                                 myerr := ZeroScrap;
  98.                                 myerr := putscrap(myclipsize, 'TEXT', myclipHandle^);
  99.                                 dopaste;
  100.                             end;
  101.                         Temphunlock(myCliphandle,myerr);
  102.                     end;
  103.             end;
  104.         TempDisposeHandle(myCliphandle,myerr);
  105.         oldA4 := SetA4(oldA4);
  106.     end;
  107. end.